home *** CD-ROM | disk | FTP | other *** search
/ The Atari Compendium / The Atari Compendium (Toad Computers) (1994).iso / files / prgtools / programm.ing / gfa / gfaexprt.lzh / GFAXPERT.LIB / STANALL.LST < prev    next >
Encoding:
File List  |  1986-10-19  |  8.8 KB  |  314 lines
  1. ' *** STANALL.LST ***           (delete this line)
  2. '
  3. ' ==============================================================================
  4. ' ********************
  5. ' ***         .GFA ***
  6. ' ********************
  7. ' *** this program runs in all resolutions
  8. '
  9. ' ------------------------------------------------------------------------------
  10. '                             *** Initiation ***
  11. '
  12. DEFWRD "a-z"                    ! word variables (-32768 to +32767) default !!
  13. @initio
  14. '
  15. ' @title.screen("TITLE",".. .... 1990",32)        ! activate in finished program
  16. ' ON BREAK GOSUB break                            ! activate in finished program
  17. '
  18. ' ------------------------------------------------------------------------------
  19. '                            *** Main Program ***
  20. '
  21. '
  22. '
  23. EDIT                            ! use this while developing program
  24. ' @exit                         ! use this in finished program
  25. '
  26. ' ------------------------------------------------------------------------------
  27. '                     *** Standard Globals and Array ***
  28. '
  29. > PROCEDURE initio
  30.   LOCAL w,h,n
  31.   '
  32.   CLS
  33.   '
  34.   @get.path(default.path$)
  35.   '
  36.   physbase%=XBIOS(2)            ! physical screen
  37.   logbase%=XBIOS(3)             ! logical screen
  38.   '
  39.   SELECT XBIOS(4)
  40.   CASE 2
  41.     high.res!=TRUE
  42.     scrn.x.max=WORK_OUT(0)                              ! 639 (regular monitor)
  43.     scrn.y.max=WORK_OUT(1)                              ! 399
  44.     ~GRAF_HANDLE(char.width,char.height,w,h)            ! 8x16 font
  45.     scrn.col.max=DIV(SUCC(scrn.x.max),char.width)       ! 80
  46.     scrn.lin.max=DIV(SUCC(scrn.y.max),char.height)      ! 25
  47.   CASE 1
  48.     med.res!=TRUE
  49.     scrn.x.max=WORK_OUT(0)                              ! 639 (regular monitor)
  50.     scrn.y.max=WORK_OUT(1)                              ! 199
  51.     ~GRAF_HANDLE(char.width,char.height,w,h)            ! 8x8 font
  52.     scrn.col.max=DIV(SUCC(scrn.x.max),char.width)       ! 80
  53.     scrn.lin.max=DIV(SUCC(scrn.y.max),char.height)      ! 25
  54.   CASE 0
  55.     low.res!=TRUE
  56.     scrn.x.max=WORK_OUT(0)                              ! 319 (regular monitor)
  57.     scrn.y.max=WORK_OUT(1)                              ! 199
  58.     ~GRAF_HANDLE(char.width,char.height,w,h)            ! 8x8 font
  59.     scrn.col.max=DIV(SUCC(scrn.x.max),char.width)       ! 40
  60.     scrn.lin.max=DIV(SUCC(scrn.y.max),char.height)      ! 25
  61.   ENDSELECT
  62.   '
  63.   IF high.res!
  64.     white=0
  65.     black=1
  66.     red=black           ! change red and green to black if in High resolution
  67.     green=black
  68.     DEFTEXT black,0,0,13
  69.   ELSE
  70.     white=0             ! default Medium colors (avoid other colors)
  71.     black=1
  72.     red=2
  73.     green=3
  74.     DEFTEXT black,0,0,6
  75.   ENDIF
  76.   '
  77.   ' *** create Standard Array color.index()
  78.   ' *** use this array to convert a VDI color-index into a 'SETCOLOR'-index
  79.   ' *** try to avoid color-index 4-15 (black in High and Medium resolution)
  80.   DIM color.index(15)
  81.   IF high.res!
  82.     RESTORE col.index.high
  83.     col.index.high:
  84.     DATA 0,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1
  85.   ENDIF
  86.   IF med.res!
  87.     RESTORE col.index.med
  88.     col.index.med:
  89.     DATA 0,3,1,2,3,3,3,3,3,3,3,3,3,3,3,3
  90.   ENDIF
  91.   IF low.res!
  92.     RESTORE col.index.low
  93.     col.index.low:
  94.     DATA 0,15,1,2,4,6,3,5,7,8,9,10,12,14,11,13
  95.   ENDIF
  96.   FOR n=0 TO 15
  97.     READ color.index(n)
  98.   NEXT n
  99.   '
  100.   ' *** default palette
  101.   IF high.res!
  102.     VSETCOLOR 1,0
  103.   ENDIF
  104.   IF med.res!
  105.     @standard.med.colors
  106.   ENDIF
  107.   IF low.res!
  108.     @standard.low.colors
  109.   ENDIF
  110.   '
  111.   on!=TRUE
  112.   off!=FALSE
  113.   '
  114.   bel$=CHR$(7)
  115.   '
  116.   return$=CHR$(13)
  117.   esc$=CHR$(27)
  118.   help$=CHR$(0)+CHR$(98)
  119.   undo$=CHR$(0)+CHR$(97)
  120.   '
  121.   interpreter$="\GFABASIC.PRG"  ! change path if necessary
  122.   run.only$="\GFABASRO.PRG"     ! Run-Only Interpreter
  123.   IF EXIST("\START.GFA")
  124.     start.gfa$="\START.GFA"     ! 'Shell' for GFA-programs (High or Medium rez)
  125.   ELSE
  126.     start.gfa$="\STARTLOW.GFA"  ! 'Shell' for Low resolution
  127.   ENDIF
  128.   start.prg$="\GFASTART.PRG"    ! 'Shell' for compiled GFA-programs
  129.   '
  130. RETURN
  131. ' **********
  132. '
  133. ' ------------------------------------------------------------------------------
  134. '                          *** Standard Functions ***
  135. '
  136. DEFFN center$(text$)=SPACE$((scrn.col.max-LEN(text$))/2)+text$
  137. DEFFN rev$(txt$)=CHR$(27)+"p"+txt$+CHR$(27)+"q"
  138. '
  139. ' ------------------------------------------------------------------------------
  140. '                         *** Standard Procedures ***
  141. '
  142. PROCEDURE get.path(VAR default.path$)
  143.   ' *** return default path (current drive and folder)
  144.   ' *** example - A:\GAMES\
  145.   ' *** WARNING : Procedure returns path$ only after CHDIR path$, else A:\
  146.   ' ***                          (even if program not in main directory !!)
  147.   LOCAL default.drive,default.drive$
  148.   CLR default.path$
  149.   default.drive=GEMDOS(&H19)
  150.   default.drive$=CHR$(default.drive+65)
  151.   default.path$=DIR$(default.drive+1)
  152.   IF default.path$<>""
  153.     default.path$=default.drive$+":"+default.path$+"\"
  154.   ELSE
  155.     default.path$=default.drive$+":\"
  156.   ENDIF
  157. RETURN
  158. ' **********
  159. '
  160. PROCEDURE standard.med.colors
  161.   ' *** standard-colors for Medium resolution
  162.   LOCAL n,col$,r,g,b
  163.   RESTORE stand.med.col
  164.   FOR n=0 TO 3
  165.     READ col$
  166.     r=VAL(LEFT$(col$))
  167.     g=VAL(MID$(col$,2,1))
  168.     b=VAL(RIGHT$(col$))
  169.     VSETCOLOR n,r,g,b
  170.   NEXT n
  171.   '
  172.   stand.med.col:
  173.   DATA 777,000,700,060
  174. RETURN
  175. ' **********
  176. '
  177. PROCEDURE standard.low.colors
  178.   ' *** standard-colors for Low resolution
  179.   LOCAL n,col$,r,g,b
  180.   RESTORE stand.low.col
  181.   FOR n=0 TO 15
  182.     READ col$
  183.     r=VAL(LEFT$(col$))
  184.     g=VAL(MID$(col$,2,1))
  185.     b=VAL(RIGHT$(col$))
  186.     VSETCOLOR n,r,g,b
  187.   NEXT n
  188.   '
  189.   stand.low.col:
  190.   DATA 777,000,700,060,007,005,520,050,555,111,077,053,707,505,550,770
  191. RETURN
  192. ' **********
  193. '
  194. PROCEDURE title.screen(title$,datum$,height)
  195.   ' *** standard title-screen
  196.   ' *** uses Standard Globals and Standard Procedure Return.key
  197.   LOCAL x,y,col,lin,name$,x1,y1,x2,y2,i
  198.   CLS
  199.   HIDEM
  200.   DEFTEXT black,8,0,height
  201.   x=(scrn.x.max-LEN(title$)*height/2)/2
  202.   y=scrn.y.max/2
  203.   TEXT x,y,title$
  204.   LET name$="© Han Kempen"      ! that's me
  205.   col=(scrn.col.max-12)/2
  206.   lin=scrn.lin.max/2+6
  207.   PRINT AT(col,lin);name$
  208.   x1=(col-2)*8
  209.   y1=(lin-1)*char.height-4
  210.   x2=x1+LEN(name$)*8+16
  211.   y2=y1+char.height+8
  212.   BOX x1,y1,x2,y2
  213.   DEFLINE 1,3
  214.   DRAW x1+3,y2+2 TO x2+2,y2+2 TO x2+2,y1+3
  215.   LINE x1+3,y2+1,x2+2,y2+1
  216.   PRINT AT(col,lin+2);datum$
  217.   @return.key
  218.   COLOR black
  219.   DEFLINE 1,1
  220.   FOR i=0 TO y
  221.     BOX i,i,scrn.x.max-i,scrn.y.max-i
  222.   NEXT i
  223.   COLOR white
  224.   FOR i=y DOWNTO 0
  225.     BOX i,i,scrn.x.max-i,scrn.y.max-i
  226.   NEXT i
  227.   COLOR black
  228.   CLS
  229. RETURN
  230. ' **********
  231. '
  232. PROCEDURE return.key
  233.   ' *** wait for <Return>
  234.   ' *** after pressing any other key, flashing 'RETURN' is turned off
  235.   ' *** uses Standard Globals
  236.   LOCAL w1$,w2$,temp$,in$
  237.   CLR in$
  238.   REPEAT
  239.   UNTIL INKEY$=""
  240.   GET 0,scrn.y.max-char.height,scrn.x.max,scrn.y.max,temp$
  241.   w1$="<RETURN>"
  242.   w2$=SPACE$(8)
  243.   PRINT AT(scrn.col.max/2-3,scrn.lin.max);w1$;
  244.   WHILE in$=""                              ! wait for any key
  245.     PAUSE 30
  246.     SWAP w1$,w2$
  247.     PRINT AT(scrn.col.max/2-3,scrn.lin.max);w1$;
  248.     in$=INKEY$
  249.   WEND
  250.   PUT 0,scrn.y.max-char.height,temp$,3    ! restore screen
  251.   WHILE in$<>return$                      ! wait for <Return>
  252.     in$=INKEY$
  253.   WEND
  254. RETURN
  255. ' **********
  256. '
  257. PROCEDURE break
  258.   ' *** activate in main program with : ON BREAK GOSUB break
  259.   ' *** do not use while developing program !
  260.   LOCAL m$,k
  261.   ON BREAK CONT
  262.   m$="*** Break ***|Continue,|Run again|or Quit"
  263.   ALERT 3,m$,1,"CONT|RUN|QUIT",k
  264.   SELECT k
  265.   CASE 1
  266.     ON BREAK                            ! true break possible for emergency
  267.     m$="Freeze current|screen (press|any key to|continue)"
  268.     ALERT 2,m$,2,"YES|NO",k
  269.     IF k=1
  270.       REPEAT
  271.       UNTIL LEN(INKEY$) OR MOUSEK
  272.     ENDIF
  273.     ON BREAK GOSUB break
  274.   CASE 2
  275.     RUN
  276.   CASE 3
  277.     @exit
  278.   ENDSELECT
  279. RETURN
  280. ' **********
  281. '
  282. PROCEDURE exit
  283.   ' *** exit program
  284.   CLS
  285.   IF EXIST(interpreter$) OR EXIST(run.only$)
  286.     ' *** program was run from (Run-Only) Interpreter
  287.     IF EXIST(start.gfa$)
  288.       CHAIN start.gfa$          ! back to 'shell'-program
  289.     ELSE
  290.       EDIT                      ! no shell
  291.     ENDIF
  292.   ELSE IF EXIST(start.gfa$)
  293.     ' *** can't find interpreter, but here is the 'shell'-program
  294.     CHAIN start.gfa$
  295.   ELSE IF EXIST(start.prg$)
  296.     ' *** compiled program started from shell
  297.     CHAIN start.prg$            ! back to shell
  298.   ELSE
  299.     ' *** compiled program
  300.     SYSTEM                      ! no shell
  301.   ENDIF
  302. RETURN
  303. ' **********
  304. '
  305. ' ------------------------------------------------------------------------------
  306. '                               *** Procedures ***
  307. '
  308. '
  309. '
  310. '
  311. ' ------------------------------------------------------------------------------
  312. '                                *** The End ***
  313. ' ==============================================================================
  314.